home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / system / UFINDER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-06  |  4.2 KB  |  175 lines
  1. unit Ufinder;
  2.  
  3. interface
  4.  
  5. uses
  6.     WinTypes, WinProcs, SysUtils, Messages, Classes, Graphics, Controls,
  7.     Forms, Dialogs, StdCtrls, Buttons, TFind, FileCtrl, ExtCtrls, ShellAPI;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ListBox1: TListBox;
  12.     FileSpec: TEdit;
  13.     Go: TBitBtn;
  14.     Label1: TLabel;
  15.     Bevel1: TBevel;
  16.     GroupBox1: TGroupBox;
  17.     CheckBox1: TCheckBox;
  18.     CheckBox2: TCheckBox;
  19.     CheckBox3: TCheckBox;
  20.     CheckBox4: TCheckBox;
  21.     CheckBox5: TCheckBox;
  22.     CheckBox6: TCheckBox;
  23.     GroupBox2: TGroupBox;
  24.     CheckBox7: TCheckBox;
  25.     CheckBox8: TCheckBox;
  26.     CheckBox9: TCheckBox;
  27.     Button1: TButton;
  28.     GroupBox3: TGroupBox;
  29.     CheckBox10: TCheckBox;
  30.     CheckBox11: TCheckBox;
  31.     Header1: THeader;
  32.     procedure GoClick(Sender: TObject);
  33.     procedure CheckBox1Click(Sender: TObject);
  34.     procedure Button1Click(Sender: TObject);
  35.     procedure FileSpecChange(Sender: TObject);
  36.     procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
  37.       Rect: TRect; State: TOwnerDrawState);
  38.     procedure Header1Sized(Sender: TObject; ASection, AWidth: Integer);
  39.     procedure ListBox1DblClick(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.     SearchFlags: Word;
  43.     procedure MyProgressHook (Sender: TObject; const Dir: String);
  44.   public
  45.     { Public declarations }
  46.   end;
  47.  
  48. var
  49.   Form1: TForm1;
  50.  
  51. implementation
  52.  
  53. {$R *.DFM}
  54.  
  55. procedure TForm1.MyProgressHook (Sender: TObject; const Dir: String);
  56. begin
  57.     Caption := 'Scanning: ' + Dir;
  58. end;
  59.  
  60. procedure TForm1.GoClick(Sender: TObject);
  61. var
  62.     tf: TTreeFind;
  63. begin
  64.     ListBox1.Clear;
  65.  
  66.     tf := TTreeFind.Create;
  67.     tf.FileSpec := FileSpec.Text;
  68.     tf.SearchFlags := SearchFlags;
  69.     tf.Progress := Self.MyProgressHook;
  70.  
  71.     Go.Enabled := False;
  72.     tf.Execute;
  73.     Caption := 'TreeFind Testbed';
  74.     Go.Enabled := True;
  75.  
  76.     if tf.TheList.Count = 0 then
  77.         Listbox1.Items.Add ('No matching files found')
  78.     else
  79.         ListBox1.Items.Assign (tf.TheList);
  80.  
  81.     tf.Free;
  82. end;
  83.  
  84. procedure TForm1.CheckBox1Click (Sender: TObject);
  85. begin
  86.     with Sender as TCheckBox do
  87.         if Checked then SearchFlags := SearchFlags or Tag
  88.     else
  89.         SearchFlags := Searchflags and (not Tag);
  90.  
  91.     CheckBox10.Enabled := not CheckBox11.Checked;
  92. end;
  93.  
  94. procedure TForm1.Button1Click(Sender: TObject);
  95. begin
  96.     Close;
  97. end;
  98.  
  99. procedure TForm1.FileSpecChange(Sender: TObject);
  100. var
  101.     DrvFlgs: Boolean;
  102. begin
  103.     DrvFlgs := (Length (FileSpec.Text) < 2) or (FileSpec.Text[2] <> ':');
  104.     CheckBox1.Enabled := DrvFlgs;
  105.     CheckBox2.Enabled := DrvFlgs;
  106.     CheckBox3.Enabled := DrvFlgs;
  107.     CheckBox4.Enabled := DrvFlgs;
  108.     CheckBox5.Enabled := DrvFlgs;
  109.     CheckBox6.Enabled := DrvFlgs;
  110. end;
  111.  
  112. function NextSection (var Str: String): String;
  113. var
  114.     idx: Integer;
  115. begin
  116.     if Str <> '' then idx := Pos (#9, Str) else idx := 0;
  117.     if idx = 0 then
  118.     begin
  119.         NextSection := Str;
  120.         Str := '';
  121.     end
  122.     else
  123.     begin
  124.         NextSection := Copy (Str, 1, idx - 1);
  125.         Delete (Str, 1, idx);
  126.     end;
  127. end;
  128.  
  129. procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  130.                                   Rect: TRect; State: TOwnerDrawState);
  131. var
  132.     Str: String;
  133.     x, idx: Integer;
  134. begin
  135.     with ListBox1, ListBox1.Canvas, Header1 do
  136.     begin
  137.         idx := 0;
  138.         FillRect (Rect);
  139.         x := Rect.left + 3;
  140.         Str := Items [Index];
  141.         while Str <> '' do
  142.         begin
  143.             TextOut (x, Rect.top, NextSection (Str));
  144.             Inc (x, SectionWidth [idx]);
  145.             Inc (idx);
  146.         end;
  147.     end;
  148. end;
  149.  
  150. procedure TForm1.Header1Sized(Sender: TObject; ASection, AWidth: Integer);
  151. begin
  152.     ListBox1.Invalidate;
  153. end;
  154.  
  155. procedure TForm1.ListBox1DblClick(Sender: TObject);
  156. var
  157.     fName: String;
  158.     TabPos: Integer;
  159. begin
  160.     with ListBox1 do
  161.         if ItemIndex <> -1 then
  162.         begin
  163.             fName := Items [ItemIndex];
  164.             { Is this a ZIP entry ? }
  165.             TabPos := Pos (#9, fName);
  166.             if TabPos <> 0 then fName := Copy (fName, TabPos + 1, 255);
  167.             ShellExecute (Handle, 'open', PChar (fName), Nil, Nil, SW_ShowNormal);
  168.         end;
  169. end;
  170.  
  171. end.
  172.  
  173.  
  174.  
  175.